Loadstar 77

home *** CD-ROM | disk | FTP | other *** search

/ Loadstar 77 / 077.d81 / hi source (.txt) < prev next >

Wrap

Commodore BASIC | 1990-01-01 | 9.5 KB | 669 lines

5 open4,4,7 10 sys700 20 .opt p4 30 *= $c700 40 ffd2 =$ffd2 50 getin =$ffe4 60 base =$a000 70 jmp start 80 lcount =* 90 .byte 0:eof =*:.byte 0,0 100 temp =* 110 .byte 0 120 col =* 130 .byte 3 140 fade =* 150 .byte 15,15,12,11,0 160 pretty =* 170 .byte 0,0 180 menu =* 190 .asc "[195][210][211][210] up/down [159]page [195][159] color [209][159] exit":.byte 0 200 prlen =*:.byte 0,0 210 prloc =*:.byte 0,0 220 page =*:.byte 0 230 curpage =*:.byte 0 240 border =*:.byte 0 250 backgr =*:.byte 0 260 start jsr $aefd 270 jsr $ad9e 280 jsr $b6a3 290 ldx $22 300 ldy $23 310 jsr $ffbd 320 loadfile lda #1 330 ldx #8 340 ldy #0 350 jsr $ffba 360 lda #0 370 ldx #<base 380 ldy #>base 390 jsr $ffd5 400 stx eof 410 sty eof+1 420 storzero stx 251 430 sty 252 440 ldy #0 450 tya 460 sta (251),y 470 lda 53280 480 sta border 490 lda 53281 500 sta backgr 510 ldy #0 520 sty 53280 530 sty 53281 540 jsr $aefd 550 jsr $ad9e 560 jsr $b6a3 570 ldx $22:stx prloc 580 ldy $23:sty prloc+1 590 ldx #23 600 sta prlen 610 lsr 620 sta prlen+1 630 lda #20 640 sec 650 sbc prlen+1 660 sta prlen+1 670 jsr figureit 680 lda 1 690 ora #1 700 sta 1 710 jsr videoin 720 lda #"[147]" 730 jsr $ffd2 740 lda #1 750 sta 646 760 lda #"[162]" 770 ldy #39 780 topline jsr $ffd2 790 dey 800 bpl topline 810 lda #3 820 sta 199 830 sta 646 840 lda #32 850 ldy #119 860 line2 jsr $ffd2 870 dey 880 bpl line2 890 lda #0 900 sta curpage 910 sta 199 920 lda #11 930 sta 646 940 lda #"[184]" 950 ldy #39 960 line3 jsr $ffd2 970 dey 980 bpl line3 990 lda #6 1000 sta 646 1010 lda #"[176]" 1020 jsr $ffd2 1030 ldy #37 1040 lda #"[192]" 1050 sigh jsr $ffd2 1060 dey 1070 bpl sigh 1080 lda #"[174]" 1090 jsr $ffd2 1100 ldx #15 1110 mainarea ldy #37 1120 lda #"[221]" 1130 jsr $ffd2 1140 lda #3 1150 sta 646 1160 lda #32 1170 ma1 jsr $ffd2 1180 dey 1190 bpl ma1 1200 lda #6 1210 sta 646 1220 lda #"[221]" 1230 jsr $ffd2 1240 dex 1250 bpl mainarea 1260 lda #"[173]" 1270 jsr $ffd2 1280 lda #"[192]" 1290 ldy #37 1300 ma3 jsr $ffd2 1310 dey 1320 bpl ma3 1330 lda #"[189]" 1340 jsr $ffd2 1350 links ldy #25 1360 linelink lda 217,y 1370 ora #128 1380 sta 217,y 1390 dey 1400 bpl linelink 1410 stx 251 1420 sty 252 1430 ldy #3:ldx #23 1440 clc 1450 jsr $fff0 1460 ldy #0 1470 smenu lda menu,y 1480 beq spretty 1490 jsr $ffd2 1500 iny 1510 jmp smenu 1520 spretty ldx #3 1530 stx 199 1540 stx 646 1550 ldx #2 1560 ldy prlen+1 1570 clc:jsr $fff0 1580 lda prloc 1590 sta 251 1600 lda prloc+1 1610 sta 252 1620 ldy #0 1630 showpret lda (251),y 1640 jsr $ffd2 1650 iny 1660 cpy prlen 1670 bne showpret 1680 main lda #<base 1690 sta 251 1700 lda #>base 1710 sta 252 1720 showpage ldx #6 1730 ldy #1 1740 clc 1750 jsr $fff0 1760 lda #0 1770 sta 646 1780 ldy #0 1790 sty lcount 1800 sty 199 1810 getit lda 1 1820 and #254 1830 sta 1 1840 sei 1850 getdata lda (251),y 1860 beq interupt 1870 cmp #13 1880 beq its13 1890 jmp print 1900 its13 jsr carriage 1910 lda lcount 1920 cmp #16 1930 bne getdata 1940 interupt cli 1950 lda 1 1960 ora #1 1970 sta 1 1980 jsr fadein 1990 jsr prinpage 2000 scankey jsr getin 2010 cmp #0 2020 beq scankey 2030 cmp #"" 2040 bne cup 2050 jsr flipup 2060 jsr fadeout 2070 jmp showpage 2080 cup cmp #"[145]" 2090 bne chcol 2100 jsr flipdown 2110 jsr fadeout 2120 jmp showpage 2130 chcol cmp #"c" 2140 bne chhome 2150 jsr color 2160 jmp scankey 2170 chhome cmp #"" 2180 bne chshift 2190 jsr fadeout 2200 lda #1 2210 sta curpage:jsr flipdown 2220 jmp showpage 2230 chshift cmp #"[147]" 2240 bne chquit 2250 ldx page 2260 stx curpage 2270 jsr fadeout 2280 jsr flipup 2290 jmp showpage 2300 chquit cmp #"q" 2310 bne chprt 2320 jmp quit 2330 chprt cmp #"p" 2340 bne ahwell 2350 jsr prompt 2360 jsr clear 2370 jmp links 2380 ahwell jmp scankey 2390 print jsr $ffd2 2400 jsr bump 2410 jmp getit 2420 quit lda 1 2430 ora #1 2440 sta 1 2450 jsr videoout 2460 rts 2470 carriage jsr $ffd2 2480 lda #"" 2490 jsr bump 2500 jsr $ffd2 2510 inc lcount 2520 rts 2530 color inc col 2540 lda col 2550 and #15 2560 sta col:sta 646 2570 cmp #0 2580 beq color 2590 cwait lda 53265 2600 bpl cwait 2610 ldy #37 2620 lda col 2630 wcolor sta 1265+54272,y 2640 sta 1305+54272,y 2650 sta 1345+54272,y 2660 sta 1385+54272,y 2670 sta 1425+54272,y 2680 sta 1465+54272,y 2690 sta 1505+54272,y 2700 sta 1545+54272,y 2710 sta 1585+54272,y 2720 sta 1625+54272,y 2730 sta 1665+54272,y 2740 sta 1705+54272,y 2750 sta 1745+54272,y 2760 sta 1785+54272,y 2770 sta 1825+54272,y 2780 sta 1865+54272,y 2790 dey 2800 bpl wcolor 2810 rts 2820 bump inc 251 2830 beq bump2 2840 rts 2850 bump2 inc 252 2860 rts 2870 clear lda 53265 2880 bpl clear 2890 ldy #37 2900 lda #32 2910 wipe sta 1265,y 2920 sta 1305,y 2930 sta 1345,y 2940 sta 1385,y 2950 sta 1425,y 2960 sta 1465,y 2970 sta 1505,y 2980 sta 1545,y 2990 sta 1585,y 3000 sta 1625,y 3010 sta 1665,y 3020 sta 1705,y 3030 sta 1745,y 3040 sta 1785,y 3050 sta 1825,y 3060 sta 1865,y 3070 dey 3080 bpl wipe 3090 rts 3100 figureit lda 1 3110 and #254 3120 sta 1 3130 lda #<base 3140 sta 251:sta ptable 3150 lda #>base 3160 sta 252:sta ptable+1 3170 ldy #0 3180 ldx #0 3190 stx page 3200 apage lda (251),y 3210 bne ckrt 3220 rts 3230 ckrt cmp #13 3240 bne incpage 3250 jsr found 3260 incpage inc 251 3270 beq bpage 3280 jmp apage 3290 bpage inc 252 3300 jmp apage 3310 found inx 3320 cpx #15 3330 bne foundout 3340 ldx #0 3350 inc page 3360 inc 251 3370 bne cpage 3380 inc 252 3390 cpage lda page 3400 asl 3410 tax 3420 lda 251 3430 sta ptable,x 3440 lda 252 3450 inx 3460 sta ptable,x 3470 ldx #0 3480 foundout rts 3490 flipup lda curpage 3500 cmp page 3510 bne ghead 3520 jmp chpage 3530 ghead inc curpage 3540 chpage lda curpage 3550 asl 3560 tax 3570 lda ptable,x 3580 sta 251 3590 inx 3600 lda ptable,x 3610 sta 252 3620 rts 3630 flipdown lda curpage 3640 bne sokay 3650 jmp chpage 3660 sokay dec curpage 3670 jmp chpage 3680 fadeout lda col 3690 sta temp 3700 sei 3710 ldx #0 3720 floop lda fade,x 3730 sta col 3740 jsr cwait 3750 inx 3760 cpx #5 3770 bne floop 3780 fout jsr clear 3790 lda temp 3800 sta col 3810 cli:rts 3820 fadein lda col 3830 sta temp 3840 ldx #5 3850 sei 3860 filoop lda fade,x 3870 sta col 3880 jsr cwait 3890 dex 3900 bne filoop 3910 lda temp 3920 sta col 3930 jsr cwait 3940 cli:rts 3950 prinpage ldx #24 3960 ldy #17 3970 clc 3980 jsr $fff0 3990 lda #12 4000 sta 646 4010 ldx curpage 4020 inx 4030 lda #0 4040 sta 199 4050 clc 4060 jsr $bdcd 4070 lda #" " 4080 jsr $ffd2 4090 lda #"o" 4100 jsr $ffd2 4110 lda #"f" 4120 jsr $ffd2 4130 lda #" " 4140 jsr $ffd2 4150 lda #0 4160 ldx page 4170 inx 4180 jsr $bdcd 4190 lda #" " 4200 jsr $ffd2 4210 lda #"[145]" 4220 jmp $ffd2 4230 videoin lda #0 4240 sta 251 4250 sta 253 4260 lda #>1024 4270 sta 252 4280 lda #>$e000 4290 sta 254 4300 jsr copy 4310 lda #>$d800 4320 sta 252 4330 lda #>$e400 4340 sta 254 4350 jsr copy 4360 rts 4370 videoout lda #0 4380 sta 251 4390 sta 253 4400 lda #>$e000 4410 sta 252 4420 lda #>$0400 4430 sta 254 4440 jsr copy 4450 lda #>$e400 4460 sta 252 4470 lda #>$d800 4480 sta 254 4490 jsr copy 4500 lda border 4510 sta 53280 4520 lda backgr 4530 sta 53281 4540 rts 4550 copy ldx #3 4560 ldy #0 4570 sei 4580 lda 1 4590 and #253 4600 sta 1 4610 copya lda (251),y 4620 sta (253),y 4630 iny 4640 bne copya 4650 inc 252 4660 inc 254 4670 dex 4680 bpl copya 4690 lda 1 4700 ora #2 4710 sta 1 4720 cli 4730 rts 4740 printout jsr openptr 4750 lda #4 4760 jsr $ffc3 ;close file 4770 jsr $ffb7 ;readst 4780 bpl (NULL)ahead 4790 flash inc 53281 4800 lda 197 4810 cmp #64 4820 bne flash 4830 lda #0 4840 sta 53281 4850 rts 4860 (NULL)ahead jsr openptr 4870 ldx #4 ; file number 4880 jsr $ffc9 ; output to file #4 4890 lda #1 4900 sta pos 4910 sta wordlen 4920 sta endpflag 4930 sta retcount 4940 inc retcount 4950 lda #" " 4960 ldx #4 4970 stx line 4980 jsr repeat 4990 jsr leftmrgn ;position printer 5000 jsr setprt 5010 here(NULL)es jsr findword ;find a word 5020 jsr printwrd ;print the word 5030 jsr advcntr ;advance hi/lo pointer 5040 ldx 197 5050 cpx #10 5060 beq formfeed 5070 ldx endpflag 5080 bpl here(NULL)es;if not end then loop 5090 formfeed lda #13 5100 jsr $ffd2 5110 inc line 5120 lda line 5130 cmp #69 5140 bcc formfeed 5150 lda #4 5160 jsr $ffc3:dec 154 5170 rts 5180 openptr lda #4; file no 5190 ldx #4; device no 5200 ldy #7 5210 jsr $ffba ;setlfs 5220 lda #0 5230 jsr $ffbd 5240 jsr $ffc0 ;open 5250 rts 5260 repeat jsr $ffd2 5270 dex 5280 bne repeat 5290 rts 5300 leftmrgn lda #13 5310 jsr $ffd2 5320 ldx #10:stx pos 5330 lda #" " 5340 jsr repeat 5350 inc line 5360 ldx line 5370 cpx #61 5380 bne notyet 5390 ldx #10 5400 lda #13 5410 npage jsr $ffd2 5420 dex 5430 bne npage 5440 lda #5 5450 sta line 5460 lda #"[160]" 5470 ldx #10 5480 stx pos 5490 jsr repeat 5500 notyet rts 5510 setprt lda #<base 5520 sta 249 5530 lda #>base 5540 sta 250 5550 rts 5560 findword ldy #0 5561 lda 1 5562 and #254 5563 sta 1 5570 fw1 lda (249),y 5580 bne nonzero 5590 ldx #129 5600 stx endpflag 5610 nonzero sta wordbuf,y 5620 notret and #95 ;32 or 160 will zero 5630 beq aha ;found a space or shift 5640 cpy #41 5650 beq aha ;word buffer is full 5660 iny 5670 bne fw1 5680 aha clc 5681 lda 1 5682 ora #1 5683 sta 1 5690 tya 5700 sta wordlen 5710 adc pos 5720 cmp #76 ;right margin 5730 bcc short 5740 jsr leftmrgn 5750 short rts 5760 printwrd ldy #0:inc wordlen 5770 ptwd1 lda wordbuf,y 5780 iny 5790 ldx wordbuf,y 5800 dey 5810 stx nchar 5820 jsr checkrt 5830 cmp #0 5840 beq ptwd2 5850 jsr $ffd2 5860 inc pos 5870 ptwd2 iny 5880 cpy wordlen 5890 bne ptwd1 5900 dec wordlen 5910 rts 5920 rts 5930 incprt inc 249 5940 bne inprtout 5950 inc 250 5960 inprtout rts 5970 decprt dec 249 5980 bne deprtout 5990 dec 250 6000 deprtout rts 6010 zeroret ldx #2 6020 stx retcount 6030 rts 6040 checkrt cmp #13 6050 beq checkrt1 6060 jsr zeroret 6070 rts 6080 checkrt1 ldx nchar 6090 cpx #32 6100 beq checksp2 6110 cpx #13 6120 beq checkrt3 6130 checkrt2 dec retcount 6140 beq checkrt3 6150 lda #" " 6160 rts 6170 checkrt3 jsr zeroret 6180 jsr leftmrgn 6190 lda #0 6200 rts 6210 checksp2 jsr leftmrgn 6220 lda #" " 6230 rts 6240 advcntr ldy wordlen 6250 advcntr1 jsr incprt 6260 dey 6270 bpl advcntr1 6280 rts 6290 prompt ldx #23 6300 ldy #0 6310 clc 6320 jsr $fff0 6330 ldy #0 6340 ptprompt lda prompta,y 6350 jsr $ffd2 6360 iny 6370 cpy #46 6380 bne ptprompt 6390 spwait jsr $ffe4 6400 beq spwait 6410 cmp #" " 6420 bne spwait1 6430 jsr printout 6440 spwait1 rts 6450 pos =* 6460 .byte 0 6470 line =* 6480 .byte 0 6490 wordlen =* 6500 .byte 0 6510 wordbuf =* 6520 .asc "this is the print buffer. it's 41 bytes." 6530 retcount =* 6540 .byte 1 6550 endpflag =* 6560 .byte 1 6570 nchar =* 6580 .byte 1 6590 prompta =* 6600 .asc " [211][208][193][195][197] [146][159] to print [193] [146][159] [193]bort " 6610 ptable =*